home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
The World of Computer Software.iso
/
sholdt.zip
/
LDTWIN.PAS
next >
Wrap
Pascal/Delphi Source File
|
1992-10-19
|
11KB
|
380 lines
{$IFNDEF Dpmi}
!! This unit requires Protected Mode !!
{$ENDIF}
{$A+,F+,I-,O-,R-,S-,T-,V-,X+}
unit LDTWin; {Window that dumps the LDT table}
{$I OPDEFINE.INC}
interface
uses
Dpmi,
OpRoot,
OpString,
OpCrt,
{$IFDEF UseMouse}
OpMouse,
{$ENDIF}
OpCmd,
OpFrame,
OpWindow,
OpEdit,
OpPick,
OpBrowse;
const
DescTableSize = 8096;
type
DescTable = Array[1..DescTableSize] of Word;
PDescTable = ^DescTable;
PLDTList = ^LDTList;
LDTList =
object(PickList)
PLDT : PDescTable;
NumDesc : Word;
constructor Init(X1, Y1, X2, Y2 : Byte);
constructor InitCustom(X1, Y1, X2, Y2 : Byte; var Colors : ColorSet;
WOpts : LongInt);
destructor Done; virtual;
procedure ItemString(Item : Word; Mode : pkMode; var iType : pkItemType;
var iString : String); virtual;
procedure Info(S : String);
procedure DefInfo;
end;
procedure ShowLDT(var Colors : ColorSet);
implementation
procedure ParseDesc(var Desc : DescriptorTableEntry;
var Base : LongInt;
var Limit : LongInt;
var TypeOfField : Byte;
var DPL : Byte);
begin
with Desc do begin
Limit := LongInt(LimitL) or (LongInt(Words[1] and $0F) shl 16);
Base := LongInt(BaseL) or
(LongInt((Words[0] and $00FF) or (Words[1] and $FF00)) shl 16);
TypeOfField := (Words[0] shr 8) and $0F;
DPL := (Words[0] shr 13) and $03;
end;
end;
function ValidDesc(var Desc : DescriptorTableEntry) : Boolean;
var
Base, Limit : LongInt;
Typ, DPL : Byte;
begin
ParseDesc(Desc, Base, Limit, Typ, DPL);
ValidDesc := (Typ <> 0) and (Typ <> $F);
end;
function LoadDescTable(P : PDescTable) : Word;
var
Sel, Index, NumEls : Word;
Desc : DescriptorTableEntry;
begin
FillChar(P^, SizeOf(DescTable), 0);
NumEls := 0;
for Index := 0 to $1FFF do begin
Sel := ((Index * 8) or 3) + 4;
if GetDescriptor(Sel, Desc) = 0 then
if ValidDesc(Desc) then begin
Inc(NumEls);
P^[NumEls] := Sel;
end;
end;
LoadDescTable := NumEls;
end;
function Desc2Str(Selector : Word;
var Desc : DescriptorTableEntry;
var P : String) : Boolean;
var
Base, Limit : LongInt;
Typ, DPL : Byte;
N : String[12];
L : LongInt;
Q : Pointer;
const
Dummy = ' ----:---- ';
CodeData : Array[Boolean] of String[5] =
(' Data', ' Code');
ReadWrite : Array[Boolean] of String[4] =
(' R ', ' R/W');
Accessed : Array[Boolean] of String[2] =
(' ', ' A');
UpDown : Array[Boolean] of String[3] =
(' Up', ' Dn');
Loaded : Array[Boolean] of String[7] =
(' ', ' Loaded');
begin
if GetDescriptor(Selector, Desc) = 0 then ;
ParseDesc(Desc, Base, Limit, Typ, DPL);
if (Typ = 0) or (Typ = $F) then begin
Desc2Str := False;
Exit;
end
else
Desc2Str := True;
P := HexW(Selector);
if GetSegmentBaseAddr(Selector, L) = 0 then begin
if L <= $000FFFFF then begin
Q := UnLinear(L);
P := P + ' ' + HexPtr(Q)+' ';
end
else
P := P + ' '+HexL(L)+' ';
end
else
P := P + Dummy;
N := Long2Str(Limit + 1);
P := P + LeftPad(N, 8) + ' ' + HexB(DPL);
if Typ and $08 > 0 then
P := P + CodeData[True]+ReadWrite[False]+' '
else
P := P + CodeData[False]+ReadWrite[(Typ and $02) > 0]+UpDown[(Typ and $04) > 0];
P := P + Accessed[Typ and $01 > 0] + Loaded[Desc.Words[0] and $8000 > 0] + HexL(Base) + ' ';
end;
constructor LDTList.Init(X1, Y1, X2, Y2 : Byte);
begin
if not LDTList.InitCustom(X1, Y1, X2, Y2, DefaultColorSet, DefWindowOptions) then
Fail;
end;
constructor LDTList.InitCustom(X1, Y1, X2, Y2 : Byte; var Colors : ColorSet;
WOpts : LongInt);
begin
if not PickList.InitAbstractDeluxe(X1, Y1, X2, Y2, Colors, WOpts,
Succ(X2-X1), 1, PickVertical,
SingleChoice,
DefPickOptions and not pkMinHeight) then Fail;
if not GetMemCheck(PLDT, DescTableSize * SizeOf(Word)) then begin
Done;
Fail;
end;
NumDesc := LoadDescTable(PLDT);
ChangeNumItems(NumDesc);
end;
destructor LDTList.Done;
begin
if PLDT <> nil then
FreeMemCheck(PLDT, DescTableSize * SizeOf(Word));
PickList.Done;
end;
procedure LDTList.ItemString(Item : Word; Mode : pkMode;
var iType : pkItemType; var iString : String);
var
Desc : DescriptorTableEntry;
begin
if not Desc2Str(PLDT^[Item], Desc, iString) then
iString := Center('** Invalid **', Width);
end;
procedure LDTList.Info(S : String);
begin
fFastWrite(Center(S, Width), 1, 1, ColorMono(wTextColor, wTextMono));
end;
procedure LDTList.DefInfo;
begin
fFastWrite(Pad('Sele Address Size Info', Width), 1, 1,
ColorMono(wTextColor, wTextMono));
end;
{-------------------------------------------------------------------------}
var
Br : BrowserPtr;
MyColors : ColorSet;
function MyEdit(MsgCode : Word; Prompt : String;
ForceUp, TrimBlanks : Boolean;
MaxLen : Byte; var S : String) : Boolean;
var
Finished : Boolean;
LE : LineEditor;
begin
with Br^, MyColors do
FastFill(Width, ' ', wYL-1, wXL, ColorMono(PromptColor, PromptMono));
LE.Init(MyColors);
if ForceUp then
LE.leEditOptionsOn(leForceUpper);
if not TrimBlanks then
LE.leEditOptionsOff(leTrimBlanks);
LE.ReadString(Prompt, Br^.wYL-1, Br^.wXL, MaxLen,
Br^.Width - Length(Prompt)-2, S);
MyEdit := (LE.GetLastCommand <> ccQuit);
LE.Done;
with Br^, MyColors do
FastFill(Width, ' ', wYL-1, wXL, ColorMono(PromptColor, PromptMono));
end;
procedure MyStatus(BP : BrowserPtr);
{-Display status line}
const
RawStatus : string[80] =
{ 1 2 3 x 4 5 6 7 8}
{12345678901234567890123456789012345678901234567890123456789012345678901234567890}
' Line x Col x ';
var
S : string[80];
{$IFDEF UseMouse}
SaveMouse : Boolean;
{$ENDIF}
procedure MergeString(T : String; N : Byte; var S : String);
begin
MoveFast(T[1], S[N], Length(T)); {!!.01}
end;
begin
with BP^ do begin
S := Pad(RawStatus, Width);
if brWorkingFlag <> 0 then
MergeString('Working...', 36, S);
MergeString(Long2Str(brCurLine), 7, S);
MergeString(Long2Str(brColOfs+1), 19, S);
{$IFDEF UseMouse}
HideMousePrim(SaveMouse);
{$ENDIF}
with MyColors do
fFastWrite(S, 1, 1, ColorMono(HeaderColor, HeaderMono));
{$IFDEF UseMouse}
ShowMousePrim(SaveMouse);
{$ENDIF}
end;
end;
procedure ShowLDT(var Colors : ColorSet);
var
LL : PLDTList;
procedure DumpSelector(Sele : Word; var Colors : ColorSet);
var
Desc : DescriptorTableEntry;
Base, Limit : LongInt;
Typ, DPL : Byte;
Bool : Boolean;
function GenerateFile : Boolean;
var
X, Y : Word;
F : File;
begin
GenerateFile := False;
if Limit > $FFFF then
Y := $FFFF
else
Y := Word(Limit);
Assign(F, 'SELECTOR.DMP');
Rewrite(F, 1);
if IOResult <> 0 then
exit;
BlockWrite(F, Ptr(Sele, 0)^, Y, X);
GenerateFile := (IOResult = 0) and (X = Y);
Close(F); if IOResult = 0 then ;
end;
begin
if GetDescriptor(Sele, Desc) = 0 then ;
ParseDesc(Desc, Base, Limit, Typ, DPL);
if Desc.Words[0] and $8000 = 0 then begin
LL^.Info('Not a valid selector - press a key:');
RingBell;
if ReadKeyWord = 0 then ;
LL^.DefInfo;
exit;
end;
LL^.Info('Generating dump...');
Bool := GenerateFile;
LL^.DefInfo;
if not Bool then exit;
New(Br, InitCustom(2, ScreenHeight - 15, 77, ScreenHeight-4, Colors,
DefWindowOptions or wBordered, $FFF0));
if Br = nil then exit;
with Br^ do begin
AdjustFrameCoords(wXL-1, wYL-2, wXH+1, wYH+1);
SetStatusProc(MyStatus);
SetEditProc(MyEdit);
{$IFDEF UseShadows}
wFrame.AddShadow(shBR, shSeeThru);
{$ENDIF}
wFrame.AddHeader(' Dump of Selector '+HexW(Sele)+' ', heTC);
wFrame.AddHeader(' <Esc> Quit ', heBC);
{$IFDEF UseScrollBars}
wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 2, 1, '■', '░', Colors);
{$ENDIF}
OpenFile('SELECTOR.DMP');
if GetLastError = 0 then begin
brOptionsOn(brHexMode);
Draw;
repeat
Process;
until GetLastCommand in [ccQuit, ccError];
Erase;
end;
Dispose(Br, Done);
end;
end;
begin
MyColors := Colors;
New(LL, InitCustom(24, 7, 70, ScreenHeight - 5, Colors,
DefWindowOptions or wBordered));
if LL = nil then
Exit;
with LL^ do begin
AdjustFrameCoords(23, 4, 71, ScreenHeight-4);
{$IFDEF UseShadows}
wFrame.AddShadow(shBR, shSeeThru);
{$ENDIF}
wFrame.AddHeader(' Current LDT ', heTC);
wFrame.AddHeader(' <Enter> View Dump, <Esc> Quit ', heBC);
wFrame.AddSpanHeader('╞','═','╡', 2, frTT);
{$IFDEF UseScrollBars}
wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 3, 1, '■', '░', Colors);
{$ENDIF}
Draw;
DefInfo;
repeat
Process;
if GetLastCommand = ccSelect then
DumpSelector(PLDT^[GetLastChoice], Colors);
until GetLastCommand in [ccQuit, ccError];
Erase;
if GetLastCommand <> ccQuit then
Halt
else
Dispose(LL, Done);
end;
end;
end.